<scriptlet>
<implements type="Automation" id="dispatcher">
	<property name="PluginEvent">
		<get/>
	</property>
	<property name="PluginDescription">
		<get/>
	</property>
	<property name="PluginFileFilters">
		<get/>
	</property>
	<property name="PluginIsAutomatic">
		<get/>
	</property>
	<method name="UnpackFile"/>
	<method name="PackFile"/>
	<method name="IsFolder"/>
	<method name="UnpackFolder"/>
	<method name="PackFolder"/>
	<method name="ShowSettingsDialog"/>
</implements>

<script language="VBS">

'/////////////////////////////////////////////////////////////////////////////
'    This is a plugin for WinMerge.
'    It will display the text content of MS Visio files.
'    Copyright (C) 2020 dedicatus
'
'    This program is free software; you can redistribute it and/or modify
'    it under the terms of the GNU General Public License as published by
'    the Free Software Foundation; either version 2 of the License, or
'    (at your option) any later version.
'
'    This program is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU General Public License for more details.
'
'    You should have received a copy of the GNU General Public License
'    along with this program; if not, write to the Free Software
'    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
'

Option Explicit

Const RegKeyPath = "HKCU\Software\Thingamahoochie\WinMerge\Plugins\CompareMSVisioFiles.sct\"
Dim MsgCannotGetMacros
MsgCannotGetMacros = "Cannot get Macros." & vbCrLf & _
	"   To allow WinMerge to compare macros, use MS Office to alter the settings in the Macro Security for the current application." & vbCrLf & _
	"   The Trust access to Visual Basic Project feature should be turned on to use this feature in WinMerge." & vbCrLf

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim wsh: Set wsh = CreateObject("WScript.Shell")

Function isAccessibleVBAProject(doc)
	Dim count
	count = -1
	On Error Resume Next
	count = doc.VBProject.VBComponents.Count
	isAccessibleVBAProject = (count > 0)
End Function

Function regRead(Key, DefaultValue)
	regRead = DefaultValue
	On Error Resume Next
	regRead = wsh.RegRead(Key)
End Function

Sub ungroupShapes(pge)
    On Error Resume Next
    Dim cnt, shp
    Do
        cnt = pge.Shapes.Count
        For Each shp In pge.Shapes
            shp.ungroup
        Next
    Loop While cnt <> pge.Shapes.Count
End Sub

Function writeTextsInShapes(fo, pge)
	Dim shp
	On Error Resume Next
	For Each shp In pge.Shapes
		fo.WriteLine shp.Name & ": " & shp.Text
	Next
End Function

Function getModuleExtension(cmp)
	Select Case cmp.Type
	Case 2
		getModuleExtension = ".cls"
	Case 3
		getModuleExtension = ".frm"
	Case Else
		getModuleExtension = ".bas"
	End Select
End Function

Function saveSlideAsImage(pge, filename)
        pge.Export filename
End Function

Function get_PluginEvent()
	get_PluginEvent = "FILE_FOLDER_PACK_UNPACK"
End Function

Function get_PluginDescription()
	get_PluginDescription = "Display the text content of MS Visio files"
End Function

Function get_PluginFileFilters()
	get_PluginFileFilters = "\.vsd(\..*)?$;\.vsdx(\..*)?$;\.vsdm(\..*)?$;\.vss(\..*)?$;\.vssx(\..*)?$;\.vssm(\..*)?$;\.vst(\..*)?$;\.vstx(\..*)?$;\.vstm(\..*)?$"
End Function

Function get_PluginIsAutomatic()
	get_PluginIsAutomatic = True
End Function

Function UnpackFile(fileSrc, fileDst, pbChanged, pSubcode)
	Dim fo
	Dim vs
	Dim doc
	Dim pge
	Dim cmp

	Set fo = fso.CreateTextFile(fileDst, True, True)

	Set vs = CreateObject("Visio.Application")
	vs.Visible = False
	vs.AlertResponse = vbNo

	Set doc = vs.Documents.OpenEx(fileSrc, &H80)

	On Error Resume Next

	For Each pge In doc.Pages
		If regRead(RegKeyPath & "CompareTextsInShapes", True) Then
			fo.WriteLine "[" & pge.Name & "]"
			ungroupShapes pge
			writeTextsInShapes fo, pge
			fo.WriteLine ""
		End If
	Next

	If regRead(RegKeyPath & "CompareVBAMacros", True) Then
		If Not isAccessibleVBAProject(doc) Then
			fo.WriteLine MsgCannotGetMacros
		End If
		For Each cmp In doc.VBProject.VBComponents
			fo.WriteLine "[CodeModule." & cmp.Name & "]"
			If cmp.CodeModule.CountOfLines > 0 Then
				fo.WriteLine cmp.CodeModule.Lines(1, cmp.CodeModule.CountOfLines)
			End If
			fo.WriteLine ""
		Next
	End If

	Set doc = Nothing
	pge.Close
	Set pge = Nothing
	vs.Quit
	Set vs = Nothing
	fo.Close
	Set fo = Nothing

	pbChanged = True
	pSubcode = 0
	UnpackFile = True

End Function

Function PackFile(fileSrc, fileDst, pbChanged, pSubcode)
	PackFile = False
End Function

Function IsFolder(file)
	IsFolder = regRead(RegKeyPath & "UnpackToFolder", False)
End Function

Function UnpackFolder(fileSrc, folderDst, pbChanged, pSubcode)
	Dim fo
	Dim vs
	Dim doc
	Dim pge
	Dim cmp

	If Not fso.FolderExists(folderDst) Then fso.CreateFolder folderDst

	Set vs = CreateObject("Visio.Application")
	vs.Visible = False
	vs.AlertResponse = vbNo

	Set doc = vs.Documents.OpenEx(fileSrc, &H80)

	On Error Resume Next

	For Each pge In doc.Pages
		If regRead(RegKeyPath & "CompareTextsInShapes", True) Then
			Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, pge.Name & ".txt"), True, True)
			ungroupShapes pge
			writeTextsInShapes fo, pge
			fo.Close
		End If


		If regRead(RegKeyPath & "ComparePageAsImage", True) Then
			saveSlideAsImage pge, fso.BuildPath(folderDst, pge.Name & ".png")
		End If
	Next
	If regRead(RegKeyPath & "CompareVBAMacros", True) Then
		If Not isAccessibleVBAProject(doc) Then
			Set fo = fso.CreateTextFile(fso.BuildPath(folderDst, "CannotGetMacros.bas"), True, True)
			fo.WriteLine MsgCannotGetMacros
			fo.Close
		End If
		
		For Each cmp In doc.VBProject.VBComponents
			cmp.Export fso.BuildPath(folderDst, cmp.Name & getModuleExtension(cmp))
		Next
	End If

	Set pge = Nothing
	doc.Close
	Set doc = Nothing
	vs.Quit
	Set vs = Nothing
	Set fo = Nothing

	pbChanged = True
	pSubcode = 0
	UnpackFolder = True
End Function

Function PackFolder(fileSrc, folderDst, pbChanged, pSubcode)
	PackFolder = False
End Function

Function ShowSettingsDialog()
	Dim tname: tname = fso.BuildPath(fso.GetSpecialFolder(2), fso.GetTempName() & ".hta")
	Dim tfile: Set tfile = fso.CreateTextFile(tname)
	tfile.Write getResource("dialog1")
	tfile.Close
	Run wsh, "mshta.exe """ & tname & """"
	fso.DeleteFile tname 
End Function

Sub Run(sh, cmd)
	sh.Run cmd, 1, True
End Sub

</script>

<resource id="dialog1">
<![CDATA[
<html>
  <head>
    <title>CompareMSVisioFiles.sct WinMerge Plugin Options</title>
    <meta content="text/html" charset="Shift_JIS">
    <style>
      body { background-color: lightgray; }
      ul { list-style:none; }
    </style>
    <script type="text/javascript">
      var REGKEY_PATH = "HKCU\\Software\\Thingamahoochie\\WinMerge\\Plugins\\CompareMSVisioFiles.sct\\";

      function regRead(key, defaultValue) {
        try {
          return (new ActiveXObject("WScript.Shell")).RegRead(key);
        } catch (e) {
          return defaultValue;
        }
      }

      function regWrite(key, value, type) {
        (new ActiveXObject("WScript.Shell")).RegWrite(key, value, type);
      }

      function onload() {

        var w = 600, h = 400;
        window.resizeTo(w, h);
        window.moveTo((screen.width - w) / 2, (screen.height - h) / 2);

        cboLanguage.selectedIndex = navigator.browserLanguage.substr(0, 2) === 'ja' ? 1 : 0;
        setLanguage(navigator.browserLanguage);
        chkUnpackToFolder.checked = regRead(REGKEY_PATH + "UnpackToFolder", false);
        chkComparePageAsImage.checked = regRead(REGKEY_PATH + "ComparePageAsImage", true);
        chkCompareTextsInShapes.checked = regRead(REGKEY_PATH + "CompareTextsInShapes", true);
        chkCompareVBAMacros.checked = regRead(REGKEY_PATH + "CompareVBAMacros", true);
        chkUnpackToFolder_onclick();
        chkComparePageAsImage_onclick();
      }

      function setLanguage(lang) {
        var div = document.getElementById("language") || document.createElement('div')
        div.id = "language";
        var html = '&shy;<style>';
        if (lang.substr(0, 2).toLowerCase() === 'ja') {
          html += '.en { display: none } .ja { display: inline }';
        } else {
          html += '.ja { display: none } .en { display: inline }';
        }
        div.innerHTML = html;
        if (!document.getElementById("language"))
          document.body.appendChild(div);
      }

      function cboLanguage_onclick() {
        setLanguage(cboLanguage.options[cboLanguage.selectedIndex].text);
      }

      function chkUnpackToFolder_onclick() {
        if (!chkUnpackToFolder.checked)
          chkComparePageAsImage.checked = false;
      }

      function chkComparePageAsImage_onclick() {
        if (chkComparePageAsImage.checked)
          chkUnpackToFolder.checked = true;
      }

      function btnOk_onclick() {
        regWrite(REGKEY_PATH + "UnpackToFolder", chkUnpackToFolder.checked, "REG_DWORD");
        regWrite(REGKEY_PATH + "ComparePageAsImage", chkComparePageAsImage.checked, "REG_DWORD");
        regWrite(REGKEY_PATH + "CompareTextsInShapes", chkCompareTextsInShapes.checked, "REG_DWORD");
        regWrite(REGKEY_PATH + "CompareVBAMacros", chkCompareVBAMacros.checked, "REG_DWORD"); window.close();
      }

      function btnCancel_onclick() {
        window.close();
      }

    </script>
  </head>
  <body onload="onload();">
    <div>
      <ul>
        <li>
          <label class="en">Language: </label>
          <label class="ja">言語: </label>
          <select id="cboLanguage" onclick="cboLanguage_onclick();" >
            <option value="English">English</option>
            <option value="Japanese">Japanese</option>
          </select>
        </li>
      </ul>
      <ul>
        <li>
          <input id="chkUnpackToFolder" type="checkbox" onclick="chkUnpackToFolder_onclick();"/>
          <label class="en">Extract page data to multiple files </label>
          <label class="ja">ページの情報を複数ファイルに展開する </label>
        </li>
        <li>
          <input id="chkComparePageAsImage" type="checkbox" onclick="chkComparePageAsImage_onclick();"/>
          <label class="en">Compare pages as image (very slow)</label>
          <label class="ja">ページを画像化して比較する (処理時間増大)</label>
        </li>
        <li>
          <input id="chkCompareTextsInShapes" type="checkbox" />
          <label class="en">Compare texts in shapes </label>
          <label class="ja">図形内のテキストを比較する </label>
        </li>
        <li>
          <input id="chkCompareVBAMacros" type="checkbox" />
          <label class="en">Compare VBA macros </label>
          <label class="ja">VBA マクロを比較する </label>
        </li>
      </ul>
      <ul>
        <li>
          <input class="en" type="button" onclick="btnOk_onclick();" value="OK" />
          <input class="en" type="button" onclick="btnCancel_onclick();" value="Cancel" />
          <input class="ja" type="button" onclick="btnOk_onclick();" value="OK" />
          <input class="ja" type="button" onclick="btnCancel_onclick();" value="キャンセル" />
        </li>
      </ul>
    </div>
  </body>
</html>
]]>
</resource>

</scriptlet>
